home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyThreads.p < prev    next >
Encoding:
Text File  |  1994-09-30  |  1.2 KB  |  59 lines  |  [TEXT/PJMM]
  1. unit MyThreads;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Threads;
  7.  
  8.     var
  9.         active_threads: integer; { YOU MUST DECREMENT active_threads }
  10.  
  11.     procedure InitMyThreads;
  12.     procedure FinishMyThreads;{ waits for all threads to complete - ie active_threads=0 }
  13.     procedure MyNewThread (proc: ProcPtr; threadParam: univ Ptr); { increments active_thread }
  14.     procedure MyYield;
  15.  
  16. implementation
  17.  
  18.     uses
  19. {$IFC undefined THINK_Pascal}
  20.         Events,
  21. {$ENDC}
  22.         MyAssertions;
  23.  
  24.     const
  25.         our_thread_stack = 16000;
  26.         our_thread_options = kCreateIfNeeded + kUsePremadeThread + kFPUNotNeeded;
  27.  
  28.     procedure MyNewThread (proc: ProcPtr; threadParam: univ Ptr);
  29.         var
  30.             thread: ThreadID;
  31.     begin
  32.         Assert(NewThread(kCooperativeThread, proc, threadParam, our_thread_stack, our_thread_options, nil, thread) = noErr);
  33.         active_threads := active_threads + 1;
  34.     end;
  35.  
  36.     procedure MyYield;
  37.         var
  38.             junk: OSErr;
  39.     begin
  40.         Assert(YieldToAnyThread = noErr);
  41.     end;
  42.  
  43.     procedure InitMyThreads;
  44.     begin
  45.         active_threads := 0;
  46.     end;
  47.  
  48.     procedure FinishMyThreads;{ waits for all threads to complete - ie active_threads=0 }
  49.         var
  50.             er: EventRecord;
  51.             dummy: boolean;
  52.     begin
  53.         while active_threads > 0 do begin
  54.             dummy := WaitNextEvent(everyEvent, er, 0, nil);
  55.             MyYield;
  56.         end;
  57.     end;
  58.  
  59. end.